home *** CD-ROM | disk | FTP | other *** search
/ Tech Win 1995 November / CD [TECH_B].bin / tech_b / delphi / trial / disk4 / doc.pak / CONTROLS.INT < prev    next >
Encoding:
Text File  |  1995-08-08  |  16.3 KB  |  490 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {                                                       }
  5. {       Copyright (c) 1995 Borland International        }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit Controls;
  10.  
  11. {$P+,S-,W-,R-}
  12. {$C PRELOAD}
  13.  
  14. interface
  15.  
  16. {$R CONTROLS}
  17.  
  18. uses WinTypes, WinProcs, Messages, Classes, SysUtils, Graphics, Menus;
  19.  
  20. { VCL control message IDs }
  21.  
  22. const
  23.   CM_BASE                   = $0F00;
  24.   CM_ACTIVATE               = CM_BASE + 0;
  25.   CM_DEACTIVATE             = CM_BASE + 1;
  26.   CM_GOTFOCUS               = CM_BASE + 2;
  27.   CM_LOSTFOCUS              = CM_BASE + 3;
  28.   CM_CANCELMODE             = CM_BASE + 4;
  29.   CM_DIALOGKEY              = CM_BASE + 5;
  30.   CM_DIALOGCHAR             = CM_BASE + 6;
  31.   CM_FOCUSCHANGED           = CM_BASE + 7;
  32.   CM_PARENTFONTCHANGED      = CM_BASE + 8;
  33.   CM_PARENTCOLORCHANGED     = CM_BASE + 9;
  34.   CM_HITTEST                = CM_BASE + 10;
  35.   CM_VISIBLECHANGED         = CM_BASE + 11;
  36.   CM_ENABLEDCHANGED         = CM_BASE + 12;
  37.   CM_COLORCHANGED           = CM_BASE + 13;
  38.   CM_FONTCHANGED            = CM_BASE + 14;
  39.   CM_CURSORCHANGED          = CM_BASE + 15;
  40.   CM_CTL3DCHANGED           = CM_BASE + 16;
  41.   CM_PARENTCTL3DCHANGED     = CM_BASE + 17;
  42.   CM_TEXTCHANGED            = CM_BASE + 18;
  43.   CM_MOUSEENTER             = CM_BASE + 19;
  44.   CM_MOUSELEAVE             = CM_BASE + 20;
  45.   CM_MENUCHANGED            = CM_BASE + 21;
  46.   CM_APPKEYDOWN             = CM_BASE + 22;
  47.   CM_APPSYSCOMMAND          = CM_BASE + 23;
  48.   CM_BUTTONPRESSED          = CM_BASE + 24;
  49.   CM_SHOWINGCHANGED         = CM_BASE + 25;
  50.   CM_ENTER                  = CM_BASE + 26;
  51.   CM_EXIT                   = CM_BASE + 27;
  52.   CM_DESIGNHITTEST          = CM_BASE + 28;
  53.   CM_ICONCHANGED            = CM_BASE + 29;
  54.   CM_WANTSPECIALKEY         = CM_BASE + 30;
  55.   CM_INVOKEHELP             = CM_BASE + 31;
  56.   CM_WINDOWHOOK             = CM_BASE + 32;
  57.   CM_RELEASE                = CM_BASE + 33;
  58.   CM_SHOWHINTCHANGED        = CM_BASE + 34;
  59.   CM_PARENTSHOWHINTCHANGED  = CM_BASE + 35;
  60.   CM_SYSCOLORCHANGE         = CM_BASE + 36;
  61.   CM_WININICHANGE           = CM_BASE + 37;
  62.   CM_FONTCHANGE             = CM_BASE + 38;
  63.   CM_TIMECHANGE             = CM_BASE + 39;
  64.  
  65. { VCL control notification IDs }
  66.  
  67. const
  68.   CN_BASE         = $2000;
  69.   CN_CHARTOITEM   = CN_BASE + WM_CHARTOITEM;
  70.   CN_COMMAND      = CN_BASE + WM_COMMAND;
  71.   CN_COMPAREITEM  = CN_BASE + WM_COMPAREITEM;
  72.   CN_CTLCOLOR     = CN_BASE + WM_CTLCOLOR;
  73.   CN_DELETEITEM   = CN_BASE + WM_DELETEITEM;
  74.   CN_DRAWITEM     = CN_BASE + WM_DRAWITEM;
  75.   CN_HSCROLL      = CN_BASE + WM_HSCROLL;
  76.   CN_MEASUREITEM  = CN_BASE + WM_MEASUREITEM;
  77.   CN_PARENTNOTIFY = CN_BASE + WM_PARENTNOTIFY;
  78.   CN_VKEYTOITEM   = CN_BASE + WM_VKEYTOITEM;
  79.   CN_VSCROLL      = CN_BASE + WM_VSCROLL;
  80.   CN_KEYDOWN      = CN_BASE + WM_KEYDOWN;
  81.   CN_KEYUP        = CN_BASE + WM_KEYUP;
  82.   CN_CHAR         = CN_BASE + WM_CHAR;
  83.   CN_SYSKEYDOWN   = CN_BASE + WM_SYSKEYDOWN;
  84.   CN_SYSCHAR      = CN_BASE + WM_SYSCHAR;
  85.  
  86. { Semi-documented Windows message IDs }
  87.  
  88. const
  89.   WM_ENTERMENULOOP = $211;
  90.   WM_VBXFIREEVENT  = $360;  { VBX event message }
  91.  
  92. { TModalResult values }
  93.  
  94. const
  95.   mrNone   = 0;
  96.   mrOk     = idOk;
  97.   mrCancel = idCancel;
  98.   mrAbort  = idAbort;
  99.   mrRetry  = idRetry;
  100.   mrIgnore = idIgnore;
  101.   mrYes    = idYes;
  102.   mrNo     = idNo;
  103.   mrAll    = mrNo + 1;
  104.  
  105. { Cursor identifiers }
  106.  
  107. const
  108.   crDefault     = 0;
  109.   crNone        = -1;
  110.   crArrow       = -2;
  111.   crCross       = -3;
  112.   crIBeam       = -4;
  113.   crSize        = -5;
  114.   crSizeNESW    = -6;
  115.   crSizeNS      = -7;
  116.   crSizeNWSE    = -8;
  117.   crSizeWE      = -9;
  118.   crUpArrow     = -10;
  119.   crHourGlass   = -11;
  120.   crDrag        = -12;
  121.   crNoDrop      = -13;
  122.   crHSplit      = -14;
  123.   crVSplit      = -15;
  124.   crMultiDrag   = -16;
  125.   crSQLWait     = -17;
  126.  
  127. type
  128.  
  129. { Forward declarations }
  130.  
  131.   TControl = class;
  132.   TWinControl = class;
  133.  
  134. { VCL control message records }
  135.  
  136.   TCMActivate = TWMNoParams;
  137.   TCMDeactivate = TWMNoParams;
  138.   TCMGotFocus = TWMNoParams;
  139.   TCMLostFocus = TWMNoParams;
  140.   TCMDialogKey = TWMKeyDown;
  141.   TCMDialogChar = TWMSysChar;
  142.   TCMHitTest = TWMNCHitTest;
  143.   TCMEnter = TWMNoParams;
  144.   TCMExit = TWMNoParams;
  145.   TCMDesignHitTest = TWMMouse;
  146.   TCMWantSpecialKey = TWMKey;
  147.  
  148.   TCMCancelMode = record
  149.     Msg: Cardinal;
  150.     Unused: Integer;
  151.     Sender: TControl;
  152.     Result: Longint;
  153.   end;
  154.  
  155.   TCMFocusChanged = record
  156.     Msg: Cardinal;
  157.     Unused: Integer;
  158.     Sender: TWinControl;
  159.     Result: Longint;
  160.   end;
  161.  
  162. { Message handlers }
  163.  
  164.   TVBXHook = procedure(Sender: TWinControl; var Message);
  165.  
  166. { Exception classes }
  167.  
  168.   EOutOfResources = class(EOutOfMemory);
  169.   EInvalidObject = class(Exception);
  170.   EInvalidOperation = class(Exception);
  171.  
  172. { Cursor type }
  173.  
  174.   TCursor = -32768..32767;
  175.  
  176. { Controls }
  177.  
  178.   TControlCanvas = class(TCanvas)
  179.   protected
  180.     procedure CreateHandle; override;
  181.   public
  182.     destructor Destroy; override;
  183.     procedure FreeHandle;
  184.     property Control: TControl;
  185.   end;
  186.  
  187.   TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient);
  188.  
  189.   TControlState = set of (csLButtonDown, csClicked, csPalette,
  190.     csReadingState, csAlignmentNeeded, csFocusing, csCreating);
  191.  
  192.   TControlStyle = set of (csAcceptsControls, csCaptureMouse,
  193.     csDesignInteractive, csClickEvents, csFramed, csSetCaption, csOpaque,
  194.     csDoubleClicks, csFixedWidth, csFixedHeight);
  195.  
  196.   TMouseButton = (mbLeft, mbRight, mbMiddle);
  197.  
  198.   TDragMode = (dmManual, dmAutomatic);
  199.  
  200.   TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
  201.  
  202.   TTabOrder = -1..32767;
  203.  
  204.   TCaption = string[255];
  205.  
  206.   TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
  207.     Shift: TShiftState; X, Y: Integer) of object;
  208.   TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
  209.     X, Y: Integer) of object;
  210.   TKeyEvent = procedure(Sender: TObject; var Key: Word;
  211.     Shift: TShiftState) of object;
  212.   TKeyPressEvent = procedure(Sender: TObject; var Key: Char) of object;
  213.   TDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer;
  214.     State: TDragState; var Accept: Boolean) of object;
  215.   TDragDropEvent = procedure(Sender, Source: TObject;
  216.     X, Y: Integer) of object;
  217.   TEndDragEvent = procedure(Sender, Target: TObject;
  218.     X, Y: Integer) of object;
  219.  
  220.   TControl = class(TComponent)
  221.   protected
  222.     procedure ChangeScale(M, D: Integer); dynamic;
  223.     procedure Click; dynamic;
  224.     procedure DblClick; dynamic;
  225.     procedure DefaultHandler(var Message); override;
  226.     procedure DefineProperties(Filer: TFiler); override;
  227.     procedure DragCanceled; dynamic;
  228.     function GetClientOrigin: TPoint; virtual;
  229.     function GetClientRect: TRect; virtual;
  230.     function GetDeviceContext(var WindowHandle: HWnd): HDC; virtual;
  231.     function GetPalette: HPALETTE; dynamic;
  232.     function HasParent: Boolean; override;
  233.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  234.       X, Y: Integer); dynamic;
  235.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  236.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  237.       X, Y: Integer); dynamic;
  238.     procedure Notification(AComponent: TComponent;
  239.       Operation: TOperation); override;
  240.     function PaletteChanged(Foreground: Boolean): Boolean; dynamic;
  241.     procedure ReadState(Reader: TReader); override;
  242.     procedure SetParent(AParent: TWinControl); virtual;
  243.     procedure SetName(const Value: TComponentName); override;
  244.     procedure SetZOrder(TopMost: Boolean); dynamic;
  245.     procedure UpdateBoundsRect(const R: TRect);
  246.     procedure VisibleChanging; dynamic;
  247.     procedure WndProc(var Message: TMessage); virtual;
  248.     property Caption: TCaption;
  249.     property Color: TColor default clWindow;
  250.     property DragCursor: TCursor default crDrag;
  251.     property DragMode: TDragMode default dmManual;
  252.     property Font: TFont;
  253.     property IsControl: Boolean;
  254.     property MouseCapture: Boolean;
  255.     property ParentColor: Boolean default True;
  256.     property ParentFont: Boolean default True;
  257.     property ParentShowHint: Boolean default True;
  258.     property PopupMenu: TPopupMenu;
  259.     property Text: TCaption;
  260.     property WindowText: PChar;
  261.     property OnClick: TNotifyEvent;
  262.     property OnDblClick: TNotifyEvent;
  263.     property OnDragDrop: TDragDropEvent;
  264.     property OnDragOver: TDragOverEvent;
  265.     property OnEndDrag: TEndDragEvent;
  266.     property OnMouseDown: TMouseEvent;
  267.     property OnMouseMove: TMouseMoveEvent;
  268.     property OnMouseUp: TMouseEvent;
  269.   public
  270.     constructor Create(AOwner: TComponent); override;
  271.     destructor Destroy; override;
  272.     procedure BeginDrag(Immediate: Boolean);
  273.     procedure BringToFront;
  274.     function ClientToScreen(const Point: TPoint): TPoint;
  275.     function Dragging: Boolean;
  276.     procedure DragDrop(DragObject: TObject; X, Y: Integer); dynamic;
  277.     procedure EndDrag(Drop: Boolean);
  278.     function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  279.     function GetTextLen: Integer;
  280.     procedure Hide;
  281.     procedure Invalidate; virtual;
  282.     function Perform(Msg, WParam: Word; LParam: Longint): Longint;
  283.     procedure Refresh;
  284.     procedure Repaint; virtual;
  285.     function ScreenToClient(const Point: TPoint): TPoint;
  286.     procedure SendToBack;
  287.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
  288.     procedure SetTextBuf(Buffer: PChar);
  289.     procedure Show;
  290.     procedure Update; virtual;
  291.     property Align: TAlign default alNone;
  292.     property BoundsRect: TRect;
  293.     property ClientHeight: Integer;
  294.     property ClientOrigin: TPoint;
  295.     property ClientRect: TRect;
  296.     property ClientWidth: Integer;
  297.     property ControlState: TControlState;
  298.     property ControlStyle: TControlStyle;
  299.     property Parent: TWinControl;
  300.     property ShowHint: Boolean;
  301.     property Visible: Boolean default True;
  302.     property Enabled: Boolean default True;
  303.   published
  304.     property Left: Integer;
  305.     property Top: Integer;
  306.     property Width: Integer;
  307.     property Height: Integer;
  308.     property Cursor: TCursor default crDefault;
  309.     property Hint: string;
  310.   end;
  311.  
  312.   TControlClass = class of TControl;
  313.  
  314.   TCreateParams = record
  315.     Caption: PChar;
  316.     Style: Longint;
  317.     ExStyle: Longint;
  318.     X, Y: Integer;
  319.     Width, Height: Integer;
  320.     WndParent: HWnd;
  321.     Param: Pointer;
  322.     WindowClass: TWndClass;
  323.     WinClassName: array[0..63] of Char;
  324.   end;
  325.  
  326.   TImeMode = (imDontCare, imDisable, imClose, imOpen, 
  327.      imHira, imKata, imAlpha, imSKata, imSAlpha);
  328.  
  329.   TWinControl = class(TControl)
  330.   protected
  331.     procedure ChangeScale(M, D: Integer); override;
  332.     procedure CreateHandle; virtual;
  333.     procedure CreateParams(var Params: TCreateParams); virtual;
  334.     procedure CreateSubClass(var Params: TCreateParams;
  335.       ControlClassName: PChar);
  336.     procedure CreateWindowHandle(const Params: TCreateParams); virtual;
  337.     procedure CreateWnd; virtual;
  338.     procedure DefaultHandler(var Message); override;
  339.     procedure DestroyHandle;
  340.     procedure DestroyWindowHandle; virtual;
  341.     procedure DestroyWnd; virtual;
  342.     function DoKeyDown(var Message: TWMKey): Boolean;
  343.     function DoKeyPress(var Message: TWMKey): Boolean;
  344.     function DoKeyUp(var Message: TWMKey): Boolean;
  345.     procedure AlignControls(AControl: TControl; var Rect: TRect); virtual;
  346.     function IsControlMouseMsg(var Message: TWMMouse): Boolean;
  347.     function FindNextControl(CurControl: TWinControl;
  348.       GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
  349.     function GetClientOrigin: TPoint; override;
  350.     function GetClientRect: TRect; override;
  351.     function GetDeviceContext(var WindowHandle: HWnd): HDC; override;
  352.     procedure DoEnter; dynamic;
  353.     procedure DoExit; dynamic;
  354.     procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;
  355.     procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic;
  356.     procedure KeyPress(var Key: Char); dynamic;
  357.     procedure MainWndProc(var Message: TMessage);
  358.     procedure NotifyControls(Msg: Word);
  359.     procedure PaintControls(DC: HDC; First: TControl);
  360.     procedure PaintHandler(var Message: TWMPaint);
  361.     procedure PaintWindow(DC: HDC); virtual;
  362.     function PaletteChanged(Foreground: Boolean): Boolean; override;
  363.     procedure ReadState(Reader: TReader); override;
  364.     procedure RecreateWnd;
  365.     procedure ScaleControls(M, D: Integer);
  366.     procedure SelectFirst;
  367.     procedure SelectNext(CurControl: TWinControl;
  368.       GoForward, CheckTabStop: Boolean);
  369.     procedure SetZOrder(TopMost: Boolean); override;
  370.     procedure ShowControl(AControl: TControl); virtual;
  371.     procedure WndProc(var Message: TMessage); override;
  372.     procedure WriteComponents(Writer: TWriter); override;
  373.     property Ctl3D: Boolean;
  374.     property DefWndProc: Pointer;
  375.     property ParentCtl3D: Boolean default True;
  376.     property WindowHandle: HWnd;
  377.     property ImeMode: TImeMode default imDontCare;
  378.     property OnEnter: TNotifyEvent;
  379.     property OnExit: TNotifyEvent;
  380.     property OnKeyDown: TKeyEvent;
  381.     property OnKeyPress: TKeyPressEvent;
  382.     property OnKeyUp: TKeyEvent;
  383.   public
  384.     constructor Create(AOwner: TComponent); override;
  385.     destructor Destroy; override;
  386.     procedure Broadcast(var Message);
  387.     function CanFocus: Boolean;
  388.     function ContainsControl(Control: TControl): Boolean;
  389.     function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl;
  390.     procedure DisableAlign;
  391.     procedure EnableAlign;
  392.     function Focused: Boolean;
  393.     procedure GetTabOrderList(List: TList);
  394.     function HandleAllocated: Boolean;
  395.     procedure HandleNeeded;
  396.     procedure InsertControl(AControl: TControl);
  397.     procedure Invalidate; override;
  398.     procedure RemoveControl(AControl: TControl);
  399.     procedure Realign;
  400.     procedure Repaint; override;
  401.     procedure ScaleBy(M, D: Integer);
  402.     procedure ScrollBy(DeltaX, DeltaY: Integer);
  403.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  404.     procedure SetFocus; virtual;
  405.     procedure Update; override;
  406.     procedure UpdateControlState;
  407.     property Brush: TBrush;
  408.     property Controls[Index: Integer]: TControl;
  409.     property ControlCount: Integer;
  410.     property Handle: HWnd;
  411.     property Showing: Boolean;
  412.     property TabOrder: TTabOrder default -1;
  413.     property TabStop: Boolean default False;
  414.  
  415.   published
  416.     property HelpContext: THelpContext default 0;
  417.   end;
  418.  
  419.   TGraphicControl = class(TControl)
  420.   protected
  421.     procedure Paint; virtual;
  422.     property Canvas: TCanvas;
  423.   public
  424.     constructor Create(AOwner: TComponent); override;
  425.     destructor Destroy; override;
  426.   end;
  427.  
  428.   TCustomControl = class(TWinControl)
  429.   protected
  430.     procedure Paint; virtual;
  431.     procedure PaintWindow(DC: HDC); override;
  432.     property Canvas: TCanvas;
  433.   public
  434.     constructor Create(AOwner: TComponent); override;
  435.     destructor Destroy; override;
  436.   end;
  437.  
  438.   THintWindow = class(TCustomControl)
  439.   protected
  440.     procedure CreateParams(var Params: TCreateParams); override;
  441.     procedure Paint; override;
  442.   public
  443.     constructor Create(AOwner: TComponent); override;
  444.     procedure ActivateHint(Rect: TRect; const AHint: string); virtual;
  445.     function IsHintMsg(var Msg: TMsg): Boolean; virtual;
  446.     procedure ReleaseHandle;
  447.     property Caption;
  448.     property Color;
  449.     property Canvas;
  450.   end;
  451.  
  452.   THintWindowClass = class of THintWindow;
  453.  
  454. function FindControl(Handle: HWnd): TWinControl;
  455. function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
  456. function GetCaptureControl: TControl;
  457. procedure SetCaptureControl(Control: TControl);
  458.  
  459. function CursorToString(Cursor: TCursor): string;
  460. function StringToCursor(S: string): TCursor;
  461. procedure GetCursorValues(Proc: TGetStrProc);
  462. function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
  463. function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
  464.  
  465. function GetShortHint(const Hint: string): string;
  466. function GetLongHint(const Hint: string): string;
  467.  
  468. procedure DragMouseMsg(var Message: TWMMouse);
  469.  
  470. const
  471.   CreationControl: TWinControl = nil;
  472.  
  473. function InitWndProc(HWindow: HWnd; Message: Word; WParam: Word;
  474.   LParam: Longint): Longint; export;
  475.  
  476. const
  477.   VBXHook: TVBXHook = nil;
  478.   VBXPropMsg: Word = $FFFF;
  479.  
  480. const
  481.   CTL3D_ALL = $FFFF;
  482.  
  483. var
  484.   NewStyleControls: Boolean;
  485.  
  486. function DrawText(DC: HDC; Str: PChar; Count: Integer; const Rect: TRect;
  487.   Format: Word): Integer;
  488.  
  489. implementation
  490.